perm filename XGPSYN.SAI[PIX,HPM]1 blob
sn#274038 filedate 1977-04-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "XGPSYN"
C00008 00003 HELPER←
C00013 00004 DO
C00016 00005 FPN←IF XGP THEN 2 ELSE 1 FPNR←0
C00022 00006 IF PAGE ∧ PN>0 THEN
C00024 00007 comment assemble line of text
C00025 00008 comment calculate height of line
C00030 00009 comment assemble line
C00040 00010 comment dislpay page
C00042 ENDMK
C⊗;
BEGIN "XGPSYN"
REQUIRE "FNTHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
BOOLEAN PRNT,XGP;
INTEGER ARRAY FHD[0:'17,0:'203];
INTEGER FNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER XCMP,YCMP,YOFF,XOFF,LMAR,TMAR,PMAR,DBUG,QUAD,LUND;
INTEGER NCHN,I,NUMCH;
INTEGER PN1,PN2,PN3;
INTEGER ARRAY PNS[0:300];
STRING INSTR,INFILE,S,HELPER,SWT;
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN
WHILE LENGTH(INSTR)=0 ∧ ¬EOF DO INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; RETURN(LOP(INSTR));
END;
SIMPLE STRING PROCEDURE MXCH(INTEGER M);
BEGIN
STRING A; INTEGER I;
A←"";
IF PRNT THEN FOR I←1 STEP 1 UNTIL M DO A←A&NXCH
ELSE FOR I←1 STEP 1 UNTIL M DO NXCH;
RETURN(A);
END;
SIMPLE INTEGER PROCEDURE PNXCH(INTEGER I);
BEGIN
INTEGER J;
J←I;
WHILE (J←J-1)≥0 ∧ LENGTH(INSTR)<I ∧ ¬EOF DO
INSTR←INSTR&INPUT(CHAN,1) ;
RETURN(INSTR[I TO I]);
END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 5],"FONT#") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNO←INTSCAN(FNTNMS,FOO);
FNTNMS←FNTNMS[2 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
OUTSTR("FONT#"&CVS(FTNO)&"="&FTNM&" ");
WHILE FNTSEL(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
OUTSTR("COULDN'T GET "&DEVPRS&":"&FILPRS&'15&'12);
OUTSTR("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
OUTSTR("FONT#"&CVS(FTNO)&"="&FTNM&" ");
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"FONT=") THEN
BEGIN
STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
OUTSTR("FONT#0="&FTNM&" ");
WHILE FNTSEL(0,FTNM,FHD[0,0])<0 DO
BEGIN
OUTSTR("COULDN'T GET "&DEVPRS&":"&FILPRS&'15&'12);
OUTSTR("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
OUTSTR("FONT#0="&FTNM&" ");
END;
END
ELSE IF EQU(FNTNMS[1 TO 6],"XLINE=") THEN
BEGIN
FNTNMS←FNTNMS[7 TO ∞];
XLINE←INTSCAN(FNTNMS,FOO);
OUTSTR("XLINE="&CVS(XLINE)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"LMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
LMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("LMAR="&CVS(LMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"PMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
PMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("PMAR="&CVS(PMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"TMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
TMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("TMAR="&CVS(TMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"XGP") THEN
BEGIN
FNTNMS←FNTNMS[4 TO ∞];
XGP←TRUE;
OUTSTR("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 4],"-XGP") THEN
BEGIN
FNTNMS←FNTNMS[5 TO ∞];
XGP←FALSE;
OUTSTR("-XGP ");
END;
END;
END;
HELPER←
"
XGPSYN displays pages from .XGP files (as produced by PUB and POX), on the
video synthesizer. It can show half pages at high resolution, full pages
lying on their side at barely readable resolution, or two unreadable pages
side by side, with their large scale structure visible.
To use it give it your file name when it asks. The .XGP extension is
assumed, and need not be typed. Then tell it the density you want, H (1/2
page), F (1 page) or D (2 pages). Next it goes into a loop asking for
page numbers. In H density you may specify a non integer page, 3.5, for
example, to see bottom half of page 3. In F density specify the full page
you wish to see. In D density the page you give, and the next one, are
displayed. Pages in files with too few formfeeds may be accessed by
appending a page count after the ff count (eg. 2-5 is the fifth page after
the ff indicating page 2). When the program types DONE, you may look at
the output at data disc terminals with <esc>47S. It usually helps to
adjust brightness and contrast.
Note that page 1 in .XGP files contains the font descriptions, and is not
interesting to display. You may also answer the page question with <cr> to
see the next window, H, F or D to change the density, V to redraw the last
display or K to erase the snthesizer.
The video synthesizer is a video rate D/A driven by data disc channels 30
through 37. H density requires 3 of these channels, F needs 4 and D wants
5. These are rarely available during heavy system load periods. About 10
CPU seconds are required to compose a single page.
";
OUTSTR("TYPE ?<CR> FOR HELP"&'15&'12&'12);
NCHN←0;
FOR I←0 STEP 1 UNTIL 2 DO IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN=0 THEN
OUTSTR("Right now there are no synthesizer channels available at all.
This program isn't worth running under those conditions."&'15&'12&'12)
ELSE IF NCHN<3 THEN
OUTSTR("Only "&CVS(NCHN)&" synthesizer channel"&
(IF NCHN=1 THEN " is" ELSE "s are")&" available, you probably don't
want to continue. Image quality will be very poor."&'15&'12&'12);
BREAKSET(1,"","A"); BREAKSET(1,'177&'12&'14,"I"); BREAKSET(1,"","O");
BREAKSET(1,"","Z");
DDINIT;
LMAR←150; TMAR←150; DBUG←TRUE; XLINE←3;
BEGIN "FILE"
INTEGER FOO,HIG,POS,I,J; STRING FIRST,FIRST1,FIRST2,FIRST3;
DEFINE FSIZE=7000;
INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS;
REAL FPN,FPNR; BOOLEAN PAGE;
FIRST←"
(or H,F or D to change density,
or V to redraw display, or K to erase it,
or just <cr> for next window.)";
FIRST1←"
(eg. 3.5 for bottom of page 3 [or 2-1.5 in files without formfeeds])";
FIRST2←" <esc>47S to view";
FIRST3←" (and optional switches)";
FCACHE(FONT[0],FSIZE);
FNTSEL(0,"FIX25.FNT[XGP,SYS]",FHD[0,0]);
DO
BEGIN
STRING SF;
CHAN←GETCHAN;
OUTSTR("FILE NAME"&FIRST3&":");
FIRST3←"";
TTYUP(TRUE);
S←INCHWL;
TTYUP(FALSE);
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN OUTSTR(HELPER) ELSE
BEGIN "FILE"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".XGP");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
NUMCH←0; PNS[0]←0;
IF LENGTH(S)>0 THEN SWITCHES(S);
LASTFF←0;
IF XGP THEN
BEGIN
SWT←"";
WHILE PNXCH(1)≠'14 DO
BEGIN
INTEGER NX;
NX←NXCH;
IF NX≠'15∧NX≠'12∧NX≠" " THEN SWT←SWT&NX;
END;
NXCH;
SWITCHES(SWT);
PNS[1]←NUMCH;
LASTFF←1;
END;
OUTSTR('15&'12);
FPN←IF XGP THEN 2 ELSE 1; FPNR←0;
S←""; PN←2;
WHILE TRUE DO
BEGIN "DENSITY"
DO
BEGIN
IF LENGTH(S)=0 THEN
BEGIN
OUTSTR("HALF, FULL OR DOUBLE DENSITY (H,F, or D)?");
QUAD←INCHWL;
END
ELSE
QUAD←LOP(S);
IF QUAD="?" THEN OUTSTR(HELPER);
QUAD←QUAD LAND '137;
END
UNTIL QUAD="H" ∨ QUAD="F" ∨ QUAD="D";
XCMP←IF QUAD="D" THEN 6 ELSE 3;
YCMP←IF QUAD="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
SAFE INTEGER ARRAY PIC[0:PIXDIM(480,512,
IF QUAD="H" THEN 3 ELSE IF QUAD="F" THEN 4 ELSE 5)];
MAKPIX(480,512,IF QUAD="H" THEN 3 ELSE IF QUAD="F" THEN 4 ELSE 5,PIC[0]);
NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
OUTSTR('15&'12&"Could only get "&CVS(NCHN)&" synthesizer channel"&
(IF NCHN=1 THEN "" ELSE "s")&", but need "&CVS(PIC[BYBI])&
". Image will be degraded."&'15&'12&'12);
DO
BEGIN "PAGES"
INTEGER FOO;
IF QUAD="D" THEN OUTSTR("FIRST PAGE #"&FIRST&":") ELSE
IF QUAD="F" THEN OUTSTR("PAGE #"&FIRST&":") ELSE
BEGIN OUTSTR("PAGE"&FIRST1&FIRST&":"); FIRST1←""; END;
FIRST←"";
S←INCHWL;
IF LENGTH(S)=0 THEN
BEGIN
PAGE←TRUE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]);
BEGIN
SAFE INTEGER ARRAY DDB[2:PIC[BYBI],0:DDSIZ];
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
IF PIC[BYBI]=3 THEN VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF) ELSE
IF PIC[BYBI]=4 THEN
VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF) ELSE
VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
FOR J←1,1 DO DPYUP(SYNMAP(0),LOCATION(DBUF));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE OUTSTR(" DONE"&'15&'12);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN
OUTSTR("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
UNGRAY(PIC[0]);
PUTPFL(PIC[0],INCHWL);
GRAY(PIC[0]);
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
MAPGRY(1,0);
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
OUTSTR(HELPER);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="F" ∨ (S LAND '137)="D" ∨ (S LAND '137)="H" THEN
BEGIN
S←S LAND '137;
OUTSTR((IF S="F" THEN "full" ELSE IF S="H" THEN "half" ELSE "double")
&" density"&'15&'12);
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO); IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN PN←FPN;
IF PAGE ∧ PN=1 ∧ XGP THEN
BEGIN
OUTSTR("Page 1 defines fonts, substance begins on page 2"&'15&'12);
PAGE←FALSE;
END
ELSE
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
LASTFF←PN-1;
WHILE LASTFF>0 ∧ PNS[LASTFF]=0 DO LASTFF←LASTFF-1;
EOF←FALSE;
USETI(CHAN,1+PNS[LASTFF]%('200*5));
INSTR←""; NUMCH←(PNS[LASTFF]%('200*5))*'200*5;
FOR I←(PNS[LASTFF] MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
END;
WIPE(PIC[0],0);
IF QUAD="H" THEN
BEGIN
YOFF←100+(FPN-PN+FPNR)*(481*4-30); XOFF←90;
END
ELSE IF QUAD="F" THEN
BEGIN
YOFF←100+FPNR*512*4; XOFF←130;
END
ELSE
BEGIN
YOFF←100+FPNR*481*4; XOFF←90;
END;
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0; FNTN←0;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
WHILE ¬EOF ∧ LASTFF<(IF QUAD="D" THEN PN+1 ELSE PN) DO
BEGIN
STRING THL,PUTSTR; INTEGER I,J,LC,YU,YL;
YL←0; YU←0;
PRNT←LASTFF≥PN-1;
IF QUAD="D" ∧ LASTFF=PN THEN
BEGIN
YOFF←100; XOFF←90-512*3;
END;
comment calculate height of line;
SBASE←BASE;
THL←""; DUN←FALSE;
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
PN1←PNXCH(1); PN2←PNXCH(2); PN3←PNXCH(3);
IF PN1='177 THEN
IF PN2='1 THEN
IF PN3≤'17 THEN
BEGIN
FTH←FHD[PN3,FNTHIG];
FTB←FHD[PN3,FNTBAS];
BASE←0;
THL←THL&MXCH(3);
END
ELSE IF PN3='43 THEN
BEGIN
BASE←((PNXCH(4) LSH 29) ASH -29);
THL←THL&MXCH(4);
END
ELSE IF PN3='52 THEN
BEGIN
BASE←BASE+((PNXCH(4) LSH 29) ASH -29);
THL←THL&MXCH(4);
END
ELSE IF PN3='40 THEN THL←THL&MXCH(5)
ELSE IF PN3='41 THEN
BEGIN
YU←YU MAX ((PNXCH(4) LSH 29) ASH -29);
YL←YL MIN ((PNXCH(4) LSH 29) ASH -29);
THL←THL&MXCH(6);
END
ELSE IF PN3='42 THEN
BEGIN
THL←THL&MXCH(4);
DUN←TRUE;
END
ELSE IF PN3='44 THEN THL←THL&MXCH(3)
ELSE IF PN3='45 THEN THL←THL&MXCH(4+PNXCH(4))
ELSE IF PN3='46 THEN THL←THL&MXCH(3)
ELSE IF PN3='47 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(4) LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
THL←THL&MXCH(4);
END
ELSE IF PN3='50 THEN THL←THL&MXCH(4)
ELSE IF PN3='51 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(5) LSH 29) ASH -29);
YU←YU MAX (YP+PNXCH(4)); YL←YL MIN YP;
THL←THL&MXCH(5);
END
ELSE THL←THL&MXCH(3)
ELSE IF PN2=2 THEN THL←THL&MXCH(3)
ELSE IF PN2=3 THEN
BEGIN
YPOS←PN3*128+PNXCH(4);
THL←THL&MXCH(4);
END
ELSE IF PN2=4 THEN THL←THL&MXCH(13)
ELSE IF PN2='11
∨ PN2='12
∨ PN2='14
∨ PN2='15
∨ (PN2≥'16 ∧PN2≤'177) THEN
BEGIN
THL←THL&MXCH(2);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE THL←THL&MXCH(2)
ELSE
BEGIN
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
PNS[LASTFF]←NUMCH+1;
OUTSTR(CVS(LASTFF)&" ");
END;
DUN←TRUE;
END;
THL←THL&MXCH(1);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END;
END "HEIGHT";
BASE←SBASE;
comment assemble line;
IF PRNT THEN
BEGIN "ASSEMBLE"
YPOS←YPOS-YL;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTHIG];
I←0;
WHILE I≤LENGTH(THL) DO
BEGIN "ASSLP"
I←I+1;
IF THL[I FOR 1]='177 THEN
IF THL[I+1 FOR 1]='1 THEN
IF THL[I+2 FOR 1]≤'17 THEN
BEGIN
FTH←FHD[FNTN←THL[I+2 FOR 1],FNTHIG];
FTB←FHD[FNTN←THL[I+2 FOR 1],FNTBAS];
BASE←0;
I←I+2;
END
ELSE IF THL[I+2 FOR 1]='43 THEN
BEGIN
BASE←((THL[I+3 FOR 1] LSH 29) ASH -29);
I←I+3;
END
ELSE IF THL[I+2 FOR 1]='52 THEN
BEGIN
BASE←BASE+((THL[I+3 FOR 1] LSH 29) ASH -29);
I←I+3;
END
ELSE IF THL[I+2 FOR 1]='40 THEN
BEGIN
XPOS←THL[I+3 FOR 1]*128+THL[I+4 FOR 1];
I←I+4;
END
ELSE IF THL[I+2 FOR 1]='41 THEN
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((THL[I+3 FOR 1] LSH 29) ASH -29))
%YCMP;
IF QUAD="F" THEN
FOR XP←XPOS+THL[I+4 FOR 1]*128+THL[I+5 FOR 1]
STEP -1 UNTIL XPOS DO
ADDEL(PIC[0],480-(XP-XOFF)%XCMP,YP,1)
ELSE
FOR XP←XPOS+THL[I+4 FOR 1]*128+THL[I+5 FOR 1]
STEP -1 UNTIL XPOS DO
ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
XPOS←XPOS+THL[I+4 FOR 1]*128+THL[I+5 FOR 1];
I←I+5;
END
ELSE IF THL[I+2 FOR 1]='42 THEN
BEGIN
YPOS←YPOS+YU+THL[I+3 FOR 1];
I←I+3;
END
ELSE IF THL[I+2 FOR 1]='44 THEN I←I+2
ELSE IF THL[I+2 FOR 1]='45 THEN I←I+3+THL[I+3 FOR 1]
ELSE IF THL[I+2 FOR 1]='46 THEN
BEGIN
I←I+2;
LUND←XPOS;
END
ELSE IF THL[I+2 FOR 1]='47 THEN
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((THL[I+3 FOR 1] LSH 29) ASH -29))
%YCMP;
IF QUAD="F" THEN
FOR XP←LUND STEP 1 UNTIL XPOS DO
ADDEL(PIC[0],480-(XP-XOFF)%XCMP,YP,1)
ELSE
FOR XP←LUND STEP 1 UNTIL XPOS DO
ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
I←I+3;
END
ELSE IF THL[I+2 FOR 1]='50 THEN I←I+3
ELSE IF THL[I+2 FOR 1]='51 THEN
BEGIN
INTEGER XP,YP,TH;
YP←(YPOS-YOFF+((THL[I+4 FOR 1] LSH 29) ASH -29))
%YCMP;
IF QUAD="F" THEN
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THL[I+3 FOR 1]-1 STEP -1 UNTIL 0 DO
ADDEL(PIC[0],480-(XP+TH-XOFF)%XCMP,YP,1)
ELSE
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THL[I+3 FOR 1]-1 STEP -1 UNTIL 0 DO
ADDEL(PIC[0],YP,(XP+TH-XOFF)%XCMP,1);
I←I+4;
END
ELSE I←I+2
ELSE IF THL[I+1 FOR 1]=2 THEN
BEGIN
XPOS←XPOS+((THL[I+2 FOR 1] LSH 29) ASH -29);
I←I+2;
END
ELSE IF THL[I+1 FOR 1]=3 THEN
BEGIN
YPOS←THL[I+2 FOR 1]*128+THL[I+3 FOR 1]-YL;
I←I+3;
END
ELSE IF THL[I+1 FOR 1]=4 THEN
BEGIN
INTEGER J,K,Y0,N,W; REAL DX,X0;
Y0←THL[I+2 FOR 1]*128+THL[I+3 FOR 1];
X0←THL[I+4 FOR 1]*128+THL[I+5 FOR 1];
DX←((THL[I+6 FOR 1]*16384+THL[I+7 FOR 1]*128+THL[I+8 FOR 1])
LSH 15) ASH -15;
DX←DX/2↑9;
N←THL[I+9 FOR 1]*128+THL[I+10 FOR 1];
W←THL[I+11 FOR 1]*128+THL[I+12 FOR 1];
FOR J←0 STEP 1 UNTIL N-1 DO
FOR K←0 STEP 1 UNTIL W-1 DO
IF QUAD="F" THEN
ADDEL(PIC[0],480-(K+X0+DX*J-XOFF)%XCMP,
(J+Y0-YOFF)%YCMP,1)
ELSE
ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+X0+DX*J-XOFF)%XCMP,1);
I←I+12;
END
ELSE IF THL[I+1 FOR 1]='11 ∨
THL[I+1 FOR 1]='12 ∨
THL[I+1 FOR 1]='14 ∨
THL[I+1 FOR 1]='15 ∨
(THL[I+1 FOR 1]≥'16 ∧THL[I+1 FOR 1]≤'177) THEN
BEGIN
IF QUAD="H" THEN
CHR3X2(FNTN,THL[I+1 FOR 1],PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="F" THEN
CHR3Y4(FNTN,THL[I+1 FOR 1],PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE
CHR6X4(FNTN,THL[I+1 FOR 1],PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
XPOS←XPOS+(FHD[FNTN,THL[I+1 FOR 1]] LSH -18);
I←I+1;
END
ELSE I←I+1
ELSE IF THL[I FOR 1]='12 THEN
BEGIN
YPOS←YPOS+YU+XLINE;
END
ELSE IF THL[I FOR 1]='15 THEN
BEGIN
XPOS←LMAR;
END
ELSE IF THL[I FOR 1]='11 THEN
BEGIN
INTEGER BLANW;
BLANW←FHD[FNTN,'40] LSH -18;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
END
ELSE IF THL[I FOR 1]='14 THEN
BEGIN
XPOS←LMAR;
YPOS←TMAR;
END
ELSE IF THL[I FOR 1]≠0 THEN
BEGIN
IF QUAD="H" THEN
CHR3X2(FNTN,THL[I FOR 1],PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="F" THEN
CHR3Y4(FNTN,THL[I FOR 1],PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE
CHR6X4(FNTN,THL[I FOR 1],PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
XPOS←XPOS+(FHD[FNTN,THL[I FOR 1]] LSH -18);
END
ELSE ;
END"ASSLP";
END "ASSEMBLE";
END;
comment dislpay page;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]); GRAY(PIC[0]);
BEGIN
SAFE INTEGER ARRAY DDB[2:PIC[BYBI],0:DDSIZ];
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
IF PIC[BYBI]=3 THEN VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF) ELSE
IF PIC[BYBI]=4 THEN
VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF) ELSE
VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
FOR J←1,1 DO DPYUP(SYNMAP(0),LOCATION(DBUF));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE OUTSTR(" DONE"&FIRST2&'15&'12);
FIRST2←"";
IF QUAD="H" THEN FPN←FPN+.5 ELSE
IF QUAD="F" THEN FPN←(PN←FPN)+1 ELSE
IF QUAD="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END "XGPSYN";